home *** CD-ROM | disk | FTP | other *** search
/ PC Electronics Plus 3 / PC Electronics Plus 3.iso / subdwg / lsp / anorma.lsp next >
Lisp/Scheme  |  1994-11-18  |  9KB  |  259 lines
  1. ;***********************************************************************
  2. ;* Funcion: aNorma
  3. ;* Comentarios: se usa para definir un area en torno a la cual
  4. ;* la norma tiene validez. Para usar este comando hay que definir
  5. ;* previamente la opcion de hatch. Esto es escoger el patron,
  6. ;* escala y color.
  7. ;***********************************************************************
  8. ;
  9. ; Change Log
  10. ; 
  11. ; 18/11/94 C.Perigault 
  12. ;
  13. ;
  14. (defun c:aNorma ( / listaNormas listaTensiones listaDistancias
  15.             listaAsociacionDistancias radio norma tension distancia
  16.             osmode cmdecho gridmode angulo p1 p2 distancia conjunto
  17.             n i pi pi/2 entidad ucs wcs)
  18.  
  19. (setq ucs 1)
  20. (setq wcs 0)
  21.   ;**********************************************************************
  22.   ;* Funcion : (printMenu lista)
  23.   ;* Comentarios : Esta funcion se utiliza para imprimir menus de seleccion
  24.   ;* en la pantalla de texto del acad para que el usuario seleccione
  25.   ;* una alternativa. La lista debe ser de la forma  (clave descripcion)
  26.   ;* donde la clave es un numero u otro objeto y descripcion un texto
  27.   ;* (generalmente)
  28.   ;************************************************************************
  29.   (defun printMenu (lista / listaTemp numeroDeFilas numero opcion)
  30.     (textscr)
  31.     (setq listaTemp lista)
  32.     (while listaTemp
  33.       (setq numeroDeFilas 0)
  34.       ; mientras tengamos elementos en la listaTemp o el numero de filas
  35.       ; sea menor que 20 imprimimos el menu en la pantalla
  36.       (while (and (< numeroDeFilas 20) listaTemp)
  37.     (princ "\n[")
  38.     (setq numero (car (car listaTemp)))
  39.     (if (< numero 10) (princ " "))
  40.     (princ numero)
  41.     (princ "] ")
  42.     (princ (cadr (car listaTemp)))
  43.     (setq numeroDeFilas (+ numeroDeFilas 1))
  44. l    (setq listaTemp (cdr listaTemp)))
  45.       (princ "\n")
  46.       (princ "\nIngrese el numero de su opcion o [enter] para continuar: ")
  47.       (setq opcion (getint ))
  48.       (if (assoc opcion lista) (setq listaTemp nil)))
  49.     (graphscr)
  50.     opcion)
  51.   ; En esta es la lista de las principales normas
  52.   (setq listaNormas '((1 "ANSI")
  53.              (2 "IEEE")
  54.              (3 "CEI NORMAL")
  55.              (4 "CEI REDUCIDA")
  56.              (5 "VDE REDUCIDA")
  57.              (6 "ENDESA")))
  58.   ; Estos son los niveles de tension normalizados
  59.   (setq listaTensiones '((1 "60-69 KV")
  60.                (2 "110 KV")
  61.                (3 "132 KV")
  62.                (4 "154 KV")
  63.                (5 "220 KV")
  64.                (6 "354 KV")
  65.                (7 "500 KV")))
  66.   ; Estas son las distancias que necesitan ser normalizadas
  67.   (setq listaDistancias
  68.    '((1  "Distancia de conductores fijos : fase-tierra")
  69.      (2  "Distancia de conductores fijos : fase-fase")
  70.      (3  "Distancia de conductores moviles : fase-tierra")
  71.      (4  "Distancia de conductores moviles : fase-fase")
  72.      (5  "Distancia de conductores moviles : distinto circuito fase-fase")
  73.      (6  "Distancia de partes vivas a gabildos de transporte")
  74.      (7  "Distancia horizontal de partes vivas al cierro exterior")
  75.      (8  "Altura al suelo de partes vivas (para peatones)")
  76.      (9  "Altura de conductor al suelo para labores de trans. regiones urbanas con alto nivel de transito" )
  77.      (10 "Altura de conductor al suelo para labores de transporte regiones suburbanas")
  78.      (11 "Altura de conductor al suleo para labores de transporte regiones rurales")
  79.    ))
  80.   ; Esta es la lista que asocia la norma tension y distancia con el
  81.   ; radio del validez de la norma
  82.   ; la lista es de la forma ( (norma tension distancia) radio)
  83.    (setq listaAsociacionDistancias
  84.     ;**ENDESA 60-69 KV**
  85.      '( ((6 1 1) 0.800)
  86.     ((6 1 2) 1.150)
  87.     ((6 1 3) 1.000)
  88.     ((6 1 4) 1.750)
  89.     ((6 1 5) 2.000)
  90.     ((6 1 6) 1.300)
  91.     ((6 1 7) 2.000)
  92.     ((6 1 8) 3.300)
  93.     ((6 1 9) 8.500)
  94.     ((6 1 10) nil)
  95.     ((6 1 11) nil)
  96.     ;**ENDESA 110 KV **
  97.     ((6 2 1) 1.250)
  98.     ((6 2 2) 1.800)
  99.     ((6 2 3) 1.600)
  100.     ((6 2 4) 2.100)
  101.     ((6 2 5) nil)
  102.     ((6 2 6) 1.750)
  103.     ((6 2 7) 2.450)
  104.     ((6 2 8) 3.700)
  105.     ((6 2 9) 9.550)
  106.     ((6 2 10) nil)
  107.     ((6 2 11) nil)
  108.     ;**ENDESA 132 KV **
  109.     ((6 3 1) 1.100)
  110.     ((6 3 2) 1.500)
  111.     ((6 3 3) 2.000)
  112.     ((6 3 4) 2.300)
  113.     ((6 3 5) 2.700)
  114.     ((6 3 6) 1.600)
  115.     ((6 3 7) 2.800)
  116.     ((6 3 8) 3.600)
  117.     ((6 3 9) nil)
  118.     ((6 3 10) nil)
  119.     ((6 3 11) nil)
  120.     ;**ENDESA 154 KV **
  121.     ((6 4 1) 1.500)
  122.     ((6 4 2) 2.500)
  123.     ((6 4 3) 2.200)
  124.     ((6 4 4) 2.800)
  125.     ((6 4 5) nil)
  126.     ((6 4 6) 2.000)
  127.     ((6 4 7) 3.000)
  128.     ((6 4 8) 4.000)
  129.     ((6 4 9) 14.750)
  130.     ((6 4 10) nil)
  131.     ((6 4 11) nil)
  132.     ;**ENDESA 220 KV **
  133.     ((6 5 1) 2.100)
  134.     ((6 5 2) 2.400)
  135.     ((6 5 3) 3.000)
  136.     ((6 5 4) 3.300)
  137.     ((6 5 5) nil)
  138.     ((6 5 6) 2.600)
  139.     ((6 5 7) 2.900)
  140.     ((6 5 8) 5.250)
  141.     ((6 5 9) 16.500)
  142.     ((6 5 10) nil)
  143.     ((6 5 11) nil)
  144.     ;**ENDESA 345 KV **
  145.     ((6 6 1) nil)
  146.     ((6 6 2) nil)
  147.     ((6 6 3) nil)
  148.     ((6 6 4) nil)
  149.     ((6 6 5) nil)
  150.     ((6 6 6) nil)
  151.     ((6 6 7) nil)
  152.     ((6 6 8) nil)
  153.     ((6 6 9) nil)
  154.     ((6 6 10) nil)
  155.     ((6 6 11) nil)
  156.     ;**ENDESA 500 KV **
  157.     ((6 7 1) 3.700)
  158.     ((6 7 2) 4.700)
  159.     ((6 7 3) 5.000)
  160.     ((6 7 4) 6.000)
  161.     ((6 7 5) nil)
  162.     ((6 7 6) 4.200)
  163.     ((6 7 7) 4.500)
  164.     ((6 7 8) 6.500)
  165.     ((6 7 9) nil)
  166.     ((6 7 10) nil)
  167.     ((6 7 11) nil)))
  168.  
  169.  
  170.  
  171.   ; Imprimimos los menus y obtenemos la seleccion del usuario
  172.   (setq radio (getreal "\nIngrese radio o [enter] para normas : "))
  173.   ; si el usuario no ingresa la distancia se le presentan las
  174.   ; normas como alternativas
  175.   (if (not radio)
  176.     (progn
  177.       ; Imprimimos los menus para que el usuario haga la seleccion
  178.       ; adecuada
  179.       (setq norma     (printMenu listaNormas))
  180.       (setq tension   (printMenu listaTensiones))
  181.       (setq distancia (printMenu listaDistancias))
  182.       (setq clave (list norma tension distancia))
  183.        (if (not (cdr (assoc clave listaAsociacionDistancias)))
  184.      ; si la clave no se encuentra le avisamos del erro
  185.      ; al usurio
  186.      (progn
  187.        (princ "\nLa opcion : ")
  188.        (princ clave)
  189.        (princ " no se encuentra ")
  190.        (setq radio nil) )
  191.      ; de encontrase la clave le presentamos la informacion de
  192.      ; esta al usuario
  193.      (progn
  194.        (princ "\n\n\nNorma : " )
  195.        (princ (cadr (assoc norma listaNormas)))
  196.        (princ "   Tension: ")
  197.        (princ (cadr (assoc tension listaTensiones)))
  198.        (princ "  Distancia :")
  199.        (princ  (cadr (assoc clave listaAsociacionDistancias)))
  200.        (princ " [m]\n")
  201.        (princ (cadr (assoc distancia listaDistancias)))
  202.        (setq radio (cadr (assoc clave listaAsociacionDistancias)))))))
  203.   ; guardamos el estado del sistema al entrar al comando
  204.   (if radio
  205.     (progn
  206.       (setq osmode   (getvar "OSMODE"  ))
  207.       (setq cmdecho  (getvar "CMDECHO" ))
  208.       (setq gridmode (getvar "GRIDMODE"))
  209.       (setvar "GRIDMODE" 0)
  210.       (setvar "CMDECHO"  0)
  211.       (setvar "OSMODE"   0)
  212.       (setq pi 3.14159265359)
  213.       (setq pi/2 (/ pi 2.0))
  214.       (princ "\nSeleccione lineas: ")
  215.       (setq conjunto (ssget))
  216.       (setq n (sslength conjunto))
  217.       (setq i 0)
  218.       ; es aqui donde empezmoas a dibujar las areas
  219.       ; solo se pueden dibujar areas para lineas y polinineas
  220.      (while (< i n)
  221.        (setq entidad (entget (ssname conjunto i)))
  222.        ; Transformamos los punto del wcs al ucs
  223.        ; para evitar complicaciones por las vistas
  224.        (setq p1 (trans (cdr (assoc 10 entidad)) wcs ucs))
  225.        (setq p2 (trans (cdr (assoc 11 entidad)) wcs ucs))
  226.        ; solo si enxisten p1 y p2 graficamos el area
  227.       (if (and p1 p2)
  228.     (progn
  229.       (setq distancia (distance p1 p2))
  230.       (setq angulo    (angle    p1 p2))
  231.       (command  "PLINE"  p1 (polar p1 (+ angulo pi/2 ) radio)
  232.            "ARC" "CE" p1 (polar p1 (+ angulo pi) radio)
  233.            "LINE"   p1 "")
  234.       (command "hatch" "" "" "" (entlast) "" )
  235.       (command  "PLINE"  p1 (polar p1 (+ angulo pi ) radio)
  236.           "ARC" "CE" p1 (polar p1 (- angulo pi/2) radio)
  237.           "LINE"   p1 "")
  238.       (command "hatch" "" "" "" (entlast) "" )
  239.       (command  "PLINE"  p2 (polar p2 angulo radio)
  240.           "ARC" "CE" p2 (polar p2 (+ angulo pi/2) radio)
  241.           "LINE"   p2 "")
  242.       (command "hatch" "" "" "" (entlast) "" )
  243.       (command  "PLINE"  p2 (polar p2 (- angulo pi/2) radio)
  244.           "ARC" "CE" p2 (polar p2 angulo  radio)
  245.           "LINE"   p2 "")
  246.       (command "hatch" "" "" "" (entlast) "" )
  247.       (command  "PLINE"  p1 p2 (polar p2 (+ angulo pi/2) radio)
  248.                  (polar p1 (+ angulo pi/2) radio)
  249.                  p1 "")
  250.       (command "hatch" "" "" "" (entlast) "" )
  251.       (command  "PLINE"  p1 p2 (polar p2 (- angulo pi/2) radio)
  252.                  (polar p1 (- angulo pi/2) radio)
  253.                  p1 "")
  254.       (command "hatch" "" "" "" (entlast) "")
  255.       (setq i (+ i 1)))))
  256.       ; volvemos al sistema a su estado inicial
  257.       (setvar "GRIDMODE" gridmode)
  258.       (setvar "OSMODE"   osmode  )
  259.       (setvar "CMDECHO"  cmdecho ))))